home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World's Largest Collection of Windows Software
/
The World's Largest Collection of Windows Software - Disc 1.iso
/
connect
/
_b1
/
mrun211
/
mrun211d.was
< prev
next >
Wrap
Text File
|
1993-05-01
|
24KB
|
795 lines
;MailRun v2.11: Part D, adddlfile
;1992-1993 Gerald P. Sully, all rights reserved.
#comment
**************************************************************************
**************************************************************************
*
* This file contains routines related to adding a "Download File"
* item to a mailrun. It puts up the Download Files dialog box,
* which displays the contents of the available files index (the
* *.idx file for the BBS). When a file is selected from the
* list, a detailed description is displayed from the *.dbf file
* for the BBS).
*
* The index may be obtained either through the getnewfiles()
* procedure, which opens *.QWK files and checks for a newfiles.dat
* file, or by importing a list from an external source. In either
* case, the file is parsed by the import() procedure.
*
**************************************************************************
**************************************************************************
#endcomment
#define MRUN211D
#define MRUN211DE
#include "MRUN211.h"
string DXFileTabs, BBSidx, BBSdbf, DLPurgeLimit, BBSChoice
integer DLSortField
#comment
*********************************************************************
*
* MAIN()
*
* Calls checkchild(), makebbslist(), makedesc(),
* getlastitem(), clearfiledesc(), getnewfiles(),
* gettaskstring(), import(), importwarning(),
* openfile(), dlfilebox(), deldlfile(), insertitem(),
* menudim(), makefullname(), interfaceon(), interfaceoff(),
* sortidx(), purgeoldfiles()
*
* Adds a GetFile item to the mailrun.
*
*********************************************************************
#endcomment
proc main
string dlfileString, statstring, ImportFile, ImportFilter, char
integer dialogstatus, Perm, j
menudim()
checkchild()
findfirst MailRun
MailRunTrunc = $FILENAME
;Set up variables for the dlfilebox
DXFileTabs = "58,92,130,305,315,319,322,325,328"
strextract BBSChoice TaskItem "`t" 3
strextract char TaskItem "`t" 4
atoi char j
profilerd MailRun "MailRun" "DLSortField" DLSortField
profilerd MailRun "MailRun" "DLPurgeLimit" DLPurgeLimit
makebbslist()
FileDesc = makefullname(TempDir, "DESC.TMP")
BBSdbf = makefullname(MailRunDir, BBSChoice)
strcat BBSdbf ".DBF"
BBSidx = makefullname(MailRunDir, BBSChoice)
strcat BBSidx ".IDX"
;Update the available files database
clearfiledesc()
FileName = ""
dlfilebox()
purgeoldfiles()
getnewfiles()
updatedlg 16
dialogstatus = $DIALOG
while dialogstatus != 1
switch dialogstatus
case 10
;User selected "Add"
if not NULLSTR FileName
;only add request if a filename has been entered
strupr FileName
Perm = 2 - PermRadio
strfmt dlfileString "1,%d,GetFile,%s,%s" Perm FileName Conf
strfmt statstring \
"Added to %s: `"Download %s from Conference %s`"" \
BBSChoice FileName Conf
;Update MAILRUN.INI, task list
j++
insertitem(BBSChoice, j, dlfileString)
TaskItem = gettaskstring(BBSChoice, j)
statmsg statstring
endif
endcase
case 11
;User selected "Delete"
deldlfile()
updatedlg 148
endcase
case 12
;User selected "Import"
;allow the user to abort operation if it will take too long
if importwarning()
ImportFilter = makefullname(MailRunDir, "*.lst")
sdlgfopen "Import File List" ImportFilter ImportFile
if SUCCESS
;if the user has selected a file to import...
interfaceoff()
statmsg "Updating database... 0 files added..."
import(ImportFile, 0)
sortidx(BBSidx, DLSortField)
statmsg ""
interfaceon()
updatedlg 16
endif
endif
endcase
case 13
;User selected "Purge"
;Set index and database files to zero length. Set display file
;to a space character. The latter is necessary becuase of an
;ASPECT bug that won't allow update of an ftext box if the
;displayed file is nonexistent or zero length.
openfile(BBSidxFile, BBSidx, _CREATE, _NORMAL)
openfile(BBSdbfFile, BBSdbf, _CREATE, _NORMAL)
fclose BBSidxFile
fclose BBSdbfFile
clearfiledesc()
FileName = ""
updatedlg 148
endcase
case 50
;User selected a new sort method
if checkfile(BBSidx)
profilewr MailRun "MailRun" "DLSortField" DLSortField
sortidx(BBSidx, DLSortField)
updatedlg 16
endif
endcase
case 130
;User selected a file from the index window
strextract FileName FileChoice "`t" 0
makedesc(BBSdbf)
updatedlg 132
endcase
case 170
;User changed BBS with the combobox
j = getlastitem(BBSChoice)
TaskItem = gettaskstring(BBSChoice, j)
;Update the available files database
BBSdbf = makefullname(MailRunDir, BBSChoice)
strcat BBSdbf ".DBF"
BBSidx = makefullname(MailRunDir, BBSChoice)
strcat BBSidx ".IDX"
purgeoldfiles()
getnewfiles()
clearfiledesc()
FileName = ""
updatedlg -1
endcase
case 230
clearfiledesc()
updatedlg 4
endcase
endswitch
dialogstatus = $DIALOG
endwhile
profilewr MailRun "MailRun" "DLPurgeLimit" DLPurgeLimit
statmsg ""
endproc
#comment
*********************************************************************
*
* IMPORTWARNING()
*
* Called by main()
*
* If sorting or duplicate filter is set, warns that an
* import operation may take a long time.
*
*********************************************************************
#endcomment
func importwarning : integer
string WarningMsg
integer Response
if (DLSortField != 1) && NewfileFilter
WarningMsg = "You have chosen to import a list of files with \
the duplicate file filter and sorting enabled. With large file \
lists, this may result in very slow performance.`r`n`r`nDo you \
wish to continue?"
elseif DLSortField != 1
WarningMsg = "You have chosen to import a list of files with \
sorting enabled. With large file \
lists, this may result in very slow performance.`r`n`r`nDo you \
wish to continue?"
elseif NewfileFilter
WarningMsg = "You have chosen to import a list of files with \
the duplicate file filter enabled. With large file \
lists, this may result in very slow performance.`r`n`r`nDo you \
wish to continue?"
else
return 1
endif
sdlgmsgbox "MailRun Message" WarningMsg QUESTION YESNO Response 2
switch Response
case 6
return 1
endcase
case 7
return 0
endcase
endswitch
endfunc
#comment
*********************************************************************
*
* PURGEOLDFILES()
*
* Called by main()
*
* Calls openfile(), interfaceon(), interfaceoff(),
* checkfile(), makefullname()
*
* Purges aged files from the download database and compresses
* the database. The current date is checked against each file
* date, and those that are aged are discarded. The number of
* days a file can be kept is determined by DLPurgeLimit, which
* is set in the Download Files dialog box.
*
*********************************************************************
#endcomment
proc purgeoldfiles
string Oldidx, Olddbf, idxString, PurgeMsg
string DLFileTrunc, FileSize, FileDate, FDesc, DescBegin, DescLength
integer char, count
long DLPurgeDays, counter, OldDate, FD, TD, DB, DL, NDB
Oldidx = makefullname(TempDir, "oldidx.tmp")
Olddbf = makefullname(TempDir, "olddbf.tmp")
if !(checkfile(BBSidx) && checkfile(BBSdbf))
return
endif
findfirst BBSidx
strsltime $FDATE "00:00:00" FD
strsltime $DATE "00:00:00" TD
atol DLPurgeLimit DLPurgeDays
if DLPurgeDays && (FD < TD)
statmsg "Purging old files... Files in database: 0"
interfaceoff()
;save the original dates of the database files so that
;getnewfiles() can function properly
getfltime BBSidx OldDate
copyfile BBSidx Oldidx
copyfile BBSdbf Olddbf
openfile(OldidxFile, Oldidx, _READWRITE, _TEXT)
openfile(OlddbfFile, Olddbf, _READWRITE, _NORMAL)
openfile(BBSidxFile, BBSidx, _CREATE, _TEXT)
openfile(BBSdbfFile, BBSdbf _CREATE, _NORMAL)
count = 0
fgets OldidxFile idxString
while not feof OldidxFile
;loop through the old .idx file
strextract FileDate idxString "`t" 2
strsltime FileDate "00:00:00" FD
if FD < (TD - (DLPurgeDays * 86400))
;if the file is older than allowed, discard it
fgets OldidxFile idxString
loopwhile
endif
count ++
strfmt PurgeMsg \
"Purging old files... Files in database: %d" count
statmsg PurgeMsg
strextract DLFileTrunc idxString "`t" 0
strextract FileSize idxString "`t" 1
strextract FDesc idxString "`t" 3
strextract DescBegin idxString "`t" 4
strextract DescLength idxString "`t" 5
atol DescBegin DB
atol DescLength DL
ftell BBSdbfFile NDB
;go to the beginning of the file description
fseek OlddbfFile DB 0
;copy the description to the new .dbf file
for counter = 1 upto DL
fgetc OlddbfFile char
fputc BBSdbfFile char
endfor
;add the index line to the new .idx file
fstrfmt BBSidxFile "%s`t%s`t%s`t%s`t%ld`t%ld`r`n" \
DLFileTrunc FileSize FileDate FDesc NDB DL
fgets OldidxFile idxString
endwhile
fclose BBSidxFile
fclose BBSdbfFile
fclose OldidxFile
fclose OlddbfFile
delfile Oldidx
delfile Olddbf
;restore the original dates of the database files
setfltime BBSidx OldDate
setfltime BBSdbf OldDate
interfaceon()
statmsg ""
endif
endproc
#comment
*********************************************************************
*
* GETNEWFILES()
*
* Called by main()
*
* Calls openfile(), interfaceon(), interfaceoff(), checkfile()
* makefullname(), import(), sortidx(), findstring()
*
* Extracts NEWFILES.DAT from a BBS .QWK packet. This is
* used to update an index file, BBS.IDX, and a database of
* descriptions, BBS.DBF, where "BBS" is the BBS ID. The
* first line of each file description in NEWFILES.DAT is
* converted to a tab delimited string containing the file's
* name, size, date and partial description. The starting
* point of the full description in the database and the
* length of the description are appended and the entire
* string is appended to the index file. Tabstops in the
* index flistbox in dlfilebox() allow push the index and
* length beyond the right edge of the box. The full
* description of each file is appended to the database file.
*
*********************************************************************
#endcomment
proc getnewfiles
string QWKFile, NewFiles, MailDir, QWKArchiver
string FPCmdLine, MRUnarcBat, Drive
integer ArcId, WinId, FirstPass, NumFiles
integer i, n
long QWKTime, IDXTime
profilerd MailRun "MailRun" "MailDir" MailDir
profilerd MailRun BBSChoice "QWKArchiver" QWKArchiver
QWKFile = makefullname(MailDir, BBSChoice)
strcat QWKFile ".QWK"
;Only update the database if there is a more recent
;QWK file for the BBS
if isfile QWKFile
getfltime QWKFile QWKTime
else
QWKTime = 0
endif
if checkfile(BBSidx) && checkfile(BBSdbf)
;if both database files exist, get their time stamps
getfltime BBSidx IDXTime
else
IDXTime = 0
endif
profilerd MailRun "MailRun" "SavePackets" n
profilerd MailRun "MailRun" "NewfileFilter" NewfileFilter
FirstPass = 1
NumFiles = 0
i = 0
interfaceoff()
while (QWKTime > IDXTime) && (i <= n)
if FirstPass
statmsg "Updating database... 0 files added..."
FirstPass = 0
endif
;Set up the unarchive command string and run it.
NewFiles = makefullname(TempDir, "NEWFILES.DAT")
if isfile NewFiles
delfile NewFiles
endif
if strcmpi QWKArchiver "FPZIPX.EXE"
;if the QWK archiver is FlashPoint ZIP (Windows-based)...
strfmt FPCmdLine "fpzipx.exe -e %s %s NEWFILES.DAT" QWKFile TempDir
run FPCmdLine MINIMIZED ArcId
taskwin ArcId WinId
;stall until execution is finished
while !(findstring($TITLEBAR, "FlashPoint")) || (WinId == $ACTIVEWIN)
endwhile
exittask ArcId
else
;otherwise, create a batch file and run it
MRUnarcBat = makefullname(TempDir, "MRUnarc.BAT")
openfile(MRUnarcFile, MRUnarcBat, _CREATE, _NORMAL)
substr Drive TempDir 0 2
fstrfmt MRunarcFile "%s`r`ncd %s`r`n" Drive TempDir
switch QWKArchiver
case "ARJ.EXE"
case "LHA.EXE"
case "LHARC.EXE"
fstrfmt MRUnarcFile "%s e %s NEWFILES.DAT`r`n" \
QWKArchiver QWKFile
endcase
case "PKUNZIP.EXE"
case "PKXARC.EXE"
fstrfmt MRUnarcFile "%s %s NEWFILES.DAT`r`n" \
QWKArchiver QWKFile
endcase
case "ZOO.EXE"
fstrfmt MRUnarcFile "%s -extract NEWFILES.DAT" \
QWKArchiver QWKFile
endcase
endswitch
fclose MRUnarcFile
run MRUnarcBat MINIMIZED ArcId
;Stall the script until unzipping is complete
while istask ArcId
endwhile
endif
import(NewFiles, &NumFiles)
QWKFile = makefullname(MailDir, BBSChoice)
strfmt QWKFile "%s.QW%d" QWKFile i
if isfile QWKFile
getfltime QWKFile QWKTime
else
QWKTime = 0
endif
i++
endwhile
if NumFiles
sortidx(BBSidx, DLSortField)
endif
setfltime BBSidx $LTIME
setfltime BBSdbf $LTIME
interfaceon()
statmsg ""
endproc
#comment
*********************************************************************
*
* IMPORT()
*
* Called by main(), getnewfiles()
*
* Calls openfile(), checkfile(), checknfstring(), findstring()
*
* Imports a file list into the download files database.
* Assumes the format is that appropriate for the BBS type
* for the current BBS.
*
*********************************************************************
#endcomment
proc import
strparm NewFiles
intparm NumFiles
string UpdateMsg
string NewFileString, NewFileName
string FileDate, FileSize, NewFileDate, NewFileSize
string idxFile, idxString
string Month, Day, Year, ThisYear
string dbfString
integer MM, DD, YY, TY
integer inidx
integer NewFileLength
long dbfIndex, dbfLength
;make sure the file exists before opening it
if isfile NewFiles
openfile(NewFilesFile, NewFiles, _READWRITE, _TEXT)
if checkfile(BBSidx) && checkfile(BBSdbf)
;If both the index and database files exist, open them
openfile(BBSidxFile, BBSidx, _READWRITE, _NORMAL)
openfile(BBSdbfFile, BBSdbf, _READWRITE, _NORMAL)
else
;If either the index or database file is missing, start from scratch
openfile(BBSidxFile, BBSidx, _CREATE, _NORMAL)
openfile(BBSdbfFile, BBSdbf, _CREATE, _NORMAL)
endif
;Go to the end of the description database
fseek BBSdbfFile 0 2
;Loop through each line of the file list checking for a valid date
;in the position appropriate for the current BBS type. If one is
;found, it can be assumed this is the first line of a file
;description. Files older than 1980 and post-dated files are
;ignored.
fgets NewFilesFile NewFileString
while not feof NewFilesFile
;loop through the file
profilerd MailRun BBSChoice "BBSType" BBSType
if findstring(BBSType, "PCBoard") || findstring(BBSType, "RBBS")
substr Month NewFileString 23 2
substr Day NewFileString 26 2
substr Year NewFileString 29 2
elseif findstring(BBSType, "WildCat")
substr Month NewFileString 24 2
substr Day NewFileString 27 2
substr Year NewFileString 30 2
elseif findstring(BBSType "Auntie")
substr Month NewFileString 21 2
substr Day NewFileString 24 2
substr Year NewFileString 27 2
endif
atoi Month MM
atoi Day DD
atoi Year YY
ThisYear = $DATE
strdelete ThisYear 0 6
atoi ThisYear TY
if (MM >= 1 && MM <= 12) && (DD >= 1 && DD <= 31) && \
(YY >= 80 && YY <= TY)
;If there is a valid date in the correct position...
;Put in tab separators
strupdt NewFileString "`t" 12 1
if findstring(BBSType, "PCBoard") || findstring(BBSType, "RBBS")
strupdt NewFileString "`t" 21 1
strupdt NewFileString "`t" 31 1
elseif findstring(BBSType, "WildCat")
strupdt NewFileString "`t" 21 1
strupdt NewFileString "`t" 32 1
strdelete NewFileString 33 1
elseif findstring(BBSType, "Auntie")
strupdt NewFileString "`t" 20 1
strupdt NewFileString "`t" 29 1
endif
;Strip extra spaces
strfind NewFileString "`t "
while FOUND
strreplace NewFileString "`t " "`t"
strfind NewFileString "`t "
endwhile
strfind NewFileString " `t"
while FOUND
strreplace NewFileString " `t" "`t"
strfind NewFileString " `t"
endwhile
if findstring(BBSType, "WildCat")
;remove commas from file size
strextract FileSize NewFileString "`t" 1
NewFileSize = FileSize
strreplace NewFileSize "," ""
strreplace NewFileString FileSize NewFileSize 1
else
;change date format from MM-DD-YY to MM/DD/YY
strextract FileDate NewFileSTring "`t" 2
NewFileDate = FileDate
strreplace NewFileDate "-" "/"
strreplace NewFileString FileDate NewFileDate 1
if strfind BBSType, "Auntie"
strextract FileDate NewFileString "`t" 0
NewFileDate = FileDate
strreplace NewFileDate " " "." 1
strfind NewFileDate ". "
while FOUND
strreplace NewFileDate ". " "."
strfind NewFileDate ". "
endwhile
strreplace NewFileString FileDate NewFileDate 1
endif
endif
strextract NewFileName NewFileString "`t" 0
if NewfileFilter
;If the newfile filter is turned on...
inidx = 0
rewind BBSidxFile
fgets BBSidxFile idxString
while not feof BBSidxFile
;Check the filename against each file in the index
strextract idxFile idxString "`t" 0
if strcmpi idxFile NewFileName
inidx = 1
exitwhile
endif
fgets BBSidxFile idxString
endwhile
if inidx
;If the file is in the index, drop it
fgets NewFilesFile NewFileString
loopwhile
endif
endif
fseek BBSidxFile 0 2
NumFiles++
strfmt UpdateMsg \
"Updating database... %d files added... %s" \
NumFiles NewFileName
statmsg UpdateMsg
strlwr NewFileName
strlen NewFileName NewFileLength
strupdt NewFileString NewFileName 0 NewFileLength
;Append the index
ftell BBSdbfFile dbfIndex
strfmt NewFileString "%s`t%ld" NewFileString dbfIndex
fputs BBSidxFile NewFileString
;Get the first line of the description and put it in
;the database
strextract dbfString NewFileString "`t" 3
fputs BBSdbfFile dbfString
;Auntie lists have a blank line before the description
if strfind BBSType "Auntie"
fgets NewFilesFile NewFileString
endif
fgets NewFilesFile NewFileString
;Get remaining lines of description
while checknfstring(&NewFileString)
fstrfmt BBSdbfFile " %s" NewFileString
fgets NewFilesFile NewFileString
endwhile
;Find the length of the description and append to the index file
ftell BBSdbfFile dbfLength
dbfLength -= dbfIndex
fstrfmt BBSidxFile "`t%ld" dbfLength
fputs BBSidxFile "`r`n"
else
;If this isn't a file description, get the next line
fgets NewFilesFile NewFileString
endif
endwhile
fclose NewFilesFile
fclose BBSidxFile
fclose BBSdbfFile
endif
endproc
#comment
*********************************************************************
*
* CHECKNFSTRING()
*
* Called by import()
*
* Checks a string for the format appropriate for a
* description line. If it is a proper description line
* the line is formatted and a value of 1 is returned.
* If it is not proper, a value of 0 is returned.
*
*********************************************************************
#endcomment
func checknfstring : integer
strparm NewFileString
string Blanks
integer i
if strfind BBSType "PCBoard"
strset blanks ' ' 33
if rstrcmp blanks NewFileString 33
strdelete NewFileString 0 33
return 1
endif
elseif strfind BBSType "WildCat"
strpeek NewFileString 33 i
if i == '|'
strdelete NewFileString 0 35
return 1
endif
elseif strfind BBSType "Auntie"
strset blanks ' ' 9
if rstrcmp blanks NewFileString 9
strdelete NewFileString 0 9
return 1
endif
endif
return 0
endfunc
#comment
*********************************************************************
*
* DELDLFILE()
*
* Called by main()
*
* Calls openfile(), interfaceon(), interfaceoff(),
* makefullname(), makedesc(), clearfiledesc()
*
* Deletes a file from the BBS's download index and selects
* the next file in the list.
*
*********************************************************************
#endcomment
proc deldlfile
string OldBBSidx, idxFile, idxString, temp
interfaceoff()
OldBBSidx = makefullname(TempDir, "OLIDX.TMP")
copyfile BBSidx OldBBSidx
openfile(OldidxFile, OldBBSidx, _READWRITE, _TEXT)
openfile(BBSidxFile, BBSidx, _CREATE, _TEXT)
fgets OldidxFile idxString
while not feof OldidxFile
strextract idxFile idxString "`t" 0
if strcmpi idxFile FileName
exitwhile
endif
fputs BBSidxFile idxString
fgets OldidxFile idxString
endwhile
fgets OldidxFile idxString
FileChoice = idxString
while not feof OldidxFile
fputs BBSidxFile idxString
fgets OldidxFile idxString
endwhile
if NULLSTR FileChoice
fseek BBSidxFile -100 2
fgets BBSidxFile temp
while not NULLSTR temp
FileChoice = temp
fgets BBSidxFile temp
endwhile
endif
fclose BBSidxFile
fclose OldidxFile
if not NULLSTR FileChoice
strextract FileName FileChoice "`t" 0
makedesc(BBSdbf)
else
clearfiledesc()
FileName = ""
endif
interfaceon()
endproc
#comment
*********************************************************************
*
* DLFILEBOX()
*
* Called by main()
*
* Displays the Download Files dialog box.
*
*********************************************************************
#endcomment
proc dlfilebox
PermRadio = 2
Conf = "0"
destroydlg
HelpPage = 9
dialogbox 19 38 324 201 15 "Download Files" helpid HelpPage
text 12 27 56 8 left "Filename"
text 70 27 40 8 left "Size"
text 104 27 34 8 left "Date"
text 142 27 117 8 left "Description"
flistbox 12 38 300 50 BBSidx DXFileTabs single FileChoice
groupbox 12 89 300 17
radiobutton 26 94 60 11 "Unsorted" DLSortField
radiobutton 91 94 67 11 "Sort by Name"
radiobutton 172 94 61 11 "Sort by Size"
radiobutton 241 94 62 11 "Sort by Date" endgroup
text 13 112 49 8 left "Filename:"
editbox 12 122 101 12 FileName
text 129 112 67 8 left "Description:"
ftext 129 122 182 50 FileDesc
text 13 141 56 8 right "Purge files after"
text 96 141 16 8 left "days"
editbox 74 139 16 12 DLPurgeLimit
text 14 158 78 8 right "D/L from Conference:"
editbox 96 156 16 12 Conf
radiobutton 12 178 53 13 "Permanent" PermRadio
radiobutton 70 178 54 13 "Temporary" endgroup
pushbutton 130 179 30 14 "&Add" normal default
pushbutton 168 179 30 14 "De&lete" normal
pushbutton 206 179 30 14 "&Import" normal
pushbutton 244 179 30 14 "&Purge" normal
pushbutton 282 179 30 14 "&Done" cancel
text 76 9 80 8 right "Download File from:"
combobox 160 7 70 42 BBSList BBSChoice sort
enddialog
endproc